home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / spcfont.zip / SPCFONT.PAS < prev   
Pascal/Delphi Source File  |  1992-06-20  |  7KB  |  211 lines
  1. Unit SPCFont;
  2. {
  3.   Unit SPCFont           created by Max Maischein, 2:246/6.17, 20.06.92
  4.  
  5.   This unit replaces the characters #1, #2, #3, #4 and #5 with
  6.   Norton-style box and copyright chars. They do not look quite the way,
  7.   Nortons do because I did not want to use the line-drawing chars.
  8.   So, if you look closely, you can see a fine line between the cross-
  9.   encasing lines. Well, I do not care, since it is just a small
  10.   inconvenience.
  11.  
  12.   If no VGA is found, the text equivalents to the remapped chars
  13.   will be used.
  14.  
  15.   CAVEATS:
  16.  
  17.   - The chars #01 through #05 are used, so you cannot use them anymore.
  18.  
  19.   - If you shell out to another program or if your program terminates,
  20.     clear the screen and remove all 'buttons' and 'copyrights', since
  21.     they will revert to their previous look if you UnInstall the charset.
  22.  
  23.   - If you already have redefined the chars #01 through #05, they will
  24.     be thrashed. Bad luck !
  25.  
  26. }
  27.  
  28. Interface
  29. Type String3 = String[ 3 ];
  30.  
  31. Function Button( State : Boolean ) : String3;
  32.   { Returns the string for a checkbox, if state is true with checkmark. }
  33.  
  34. Procedure InstallCharset;
  35.   { Installs the new font, remapping chars #01 - #05 }
  36.  
  37. Procedure UnInstallCharSet;
  38.   { Removes the new font, restoring the original VGA font }
  39.  
  40. Function CopyRight : String3;
  41.   { returns the string for a copyright "(c)" }
  42.  
  43. Implementation
  44. CONST ButtonOffString : String = '[ ]';  { these are the strings returned  }
  45.       ButtonOnString  : String = '[■]';  { if the program runs on a nonVGA }
  46.       CopyRightString : String = '(c)';  { system.                         }
  47.  
  48. Procedure FontData;
  49.   { The data for the new font. It is declared as a dummy procedure,
  50.     so no space is used in the data segment.                        }
  51.  
  52. Assembler;
  53. Asm
  54.  
  55. { #1 }  db      000h, 007h, 006h, 006h, 006h, 006h, 006h, 006h, 006h, 006h, 006h, 006h, 007h, 007h, 000h, 000h
  56. { #2 }  db      000h, 0E0h, 020h, 020h, 020h, 020h, 020h, 020h, 020h, 020h, 020h, 020h, 0E0h, 0E0h, 000h, 000h
  57. { #3 }  db      000h, 0FFh, 000h, 000h, 000h, 000h, 000h, 000h, 000h, 000h, 000h, 000h, 0FFh, 0FFh, 000h, 000h
  58. { #4 }  db      000h, 0FFh, 000h, 081h, 0C3h, 066h, 03Ch, 03Ch, 066h, 0C3h, 081h, 000h, 0FFh, 0FFh, 000h, 000h
  59. { #5 }  db      000h, 000h, 000h, 03Ch, 042h, 099h, 0A5h, 0A1h, 0A5h, 099h, 042h, 03Ch, 000h, 000h, 000h, 000h
  60. End;
  61.  
  62. Procedure OldFont;
  63.   { The data of the original VGA font. If you don't like this, you will
  64.     have to change the data ;-)                                         }
  65.  
  66. Assembler;
  67. Asm
  68.  
  69.         db      000h, 000h, 07Eh, 081h, 0A5h, 081h, 081h, 0BDh, 099h, 081h, 081h, 07Eh, 000h, 000h, 000h, 000h  
  70.         db      000h, 000h, 07Eh, 0FFh, 0DBh, 0FFh, 0FFh, 0C3h, 0E7h, 0FFh, 0FFh, 07Eh, 000h, 000h, 000h, 000h  
  71.         db      000h, 000h, 000h, 000h, 06Ch, 0FEh, 0FEh, 0FEh, 0FEh, 07Ch, 038h, 010h, 000h, 000h, 000h, 000h  
  72.         db      000h, 000h, 000h, 000h, 010h, 038h, 07Ch, 0FEh, 07Ch, 038h, 010h, 000h, 000h, 000h, 000h, 000h  
  73.         db      000h, 000h, 000h, 018h, 03Ch, 03Ch, 0E7h, 0E7h, 0E7h, 018h, 018h, 03Ch, 000h, 000h, 000h, 000h 
  74. End;
  75.  
  76. Function CopyRight : String3;
  77. Begin
  78.   CopyRight := CopyRightString;
  79. End;
  80.  
  81. Function Button( State : Boolean ) : String3;
  82. Begin
  83.  
  84.   If State
  85.     then Button := ButtonOnString
  86.     else Button := ButtonOffString
  87. End;
  88.  
  89. Function VGAAvail : Boolean; { determines, if a VGA is present }
  90. Assembler;
  91. {INT 10 - VIDEO - GET INDIVIDUAL PALETTE REGISTER (VGA)}
  92. Asm
  93.         mov     ax, 1007h
  94.         xor     bx, bx
  95.         int     10h
  96.         jc      @NoVGA
  97.         mov     al, 1
  98.         ret
  99. @NoVGA:
  100.         xor     ax, ax
  101.         ret
  102. End;
  103.  
  104. Function HercAvail : Boolean; { determines, wether hercules mode ( 7 ) is active or not }
  105. Assembler;
  106. Asm
  107.         mov     ax, 0040h
  108.         mov     es, ax
  109.         mov     al, es:[ 49h ]     { BIOS segment : 49h -> current videomode }
  110.         cmp     al, 7              { mode 7 ( Hercules ) ? }
  111.         je      @HercMode          { yes, return true }
  112.         mov     al, 6              { no, set up al for false / 0 }
  113. @HercMode:
  114.         sub     al, 6              { al = 7 or 6, so this will give 1 or 0 }
  115.         ret
  116. End;
  117.  
  118. Procedure InstallCharset;
  119. Begin
  120.  
  121.   If not HercAvail AND VGAAvail
  122.     then
  123.       Begin
  124.         Asm;
  125.  
  126.         push    bp
  127.  
  128.         mov     si, 40h
  129.         mov     es, si
  130.         mov     ax, es:[ 60h ]
  131.         push    ax                 { save old cursor style on stack }
  132.  
  133.         mov     ax, seg FontData
  134.         mov     es, ax
  135.  
  136.         mov     ax, 1100h           { Load userdefined charset }
  137.         mov     bx, 1000h           { bh = bytes per char ( 10h ); bl = page ( 0h ) }
  138.         mov     cx, 0005h           { number of patterns }
  139.         mov     dx, 0001h           { dx = first char }
  140.         mov     bp, offset FontData { es:bp -> new char table }
  141.  
  142.         int     10h                 { install the new chars }
  143.  
  144.         mov     ah, 12h
  145.         mov     bh, 20h
  146.  
  147.         int     10h                 { and set up the printscreen procedure }
  148.  
  149.         mov     ax,0100h
  150.         pop     cx                  { get the old cursor style }
  151.         int     10h                 { and restore it }
  152.  
  153.         pop     bp                  { restore bp }
  154.     End;
  155.       ButtonOffString := #01#03#02; { and set up the strings       }
  156.       ButtonOnString  := #01#04#02;
  157.       CopyRightString := #32#05#32;
  158.  
  159.     End
  160.   Else
  161.     Begin
  162.  
  163.       ButtonOffString := '[ ]';
  164.       ButtonOnString  := '[X]';
  165.       CopyRightString := '(c)';
  166.  
  167.     End;
  168. End;
  169.  
  170. Procedure UnInstallCharSet;
  171. Begin
  172.   If VGAAvail
  173.     then
  174.       Asm
  175.         push    bp
  176.  
  177.         mov     si, 40h
  178.         mov     es, si
  179.         mov     ax, es:[ 60h ]
  180.         push    ax                 { save old cursor style on stack }
  181.  
  182.         mov     ax, seg OldFont
  183.         mov     es, ax
  184.  
  185.         mov     ax, 1100h           { Load userdefined charset }
  186.         mov     bx, 1000h           { bh = bytes per char ( 10h ); bl = page ( 0h ) }
  187.         mov     cx, 0005h           { number of patterns }
  188.         mov     dx, 0001h           { dx = first char }
  189.         mov     bp, offset OldFont  { es:bp -> new char table }
  190.  
  191.         int     10h                 { install the new chars }
  192.  
  193.         mov     ah, 12h
  194.         mov     bh, 20h
  195.  
  196.         int     10h                 { and set up the printscreen procedure }
  197.  
  198.         mov     ax,0100h
  199.         pop     cx                  { get the old cursor style }
  200.         int     10h                 { and restore it }
  201.  
  202.         pop     bp                  { restore bp }
  203.     End;
  204.  
  205.   ButtonOffString := '[ ]';
  206.   ButtonOnString  := '[X]';
  207.   CopyRightString := '(c)';
  208.  
  209. End;
  210.  
  211. End.